home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol350 / prolog.arc / EXPERT.ARC / GENIAL.PRO < prev    next >
Encoding:
Text File  |  1986-09-08  |  9.8 KB  |  308 lines
  1. write( 'GENIAL --- 9/8/86' ).
  2. write( 'Prof. James Boster' ).
  3. write( 'Dept. of Anthropology' ).
  4. write( 'University of Pittsburgh' ).
  5. write( 'Pittsburgh, PA 15260' ).
  6.  
  7. write( 'This prolog program illustrates a rule system for kinship terminology ' ).
  8. write( 'that is much more complete than the usual alice and victoria example.' ).
  9. write( 'It has been illustrated on a data base of the descent of English kings ' ).
  10. write( 'taken from An Encyclopedia of World History, edited by William Langer.' ).
  11. write( 'The page numbers refer to geneological tables in that text' ).
  12. write( 'One could just as easily substitute ones own family for the kings.' ).
  13.  
  14. write( 'This program would be improved by replacing numbers for each individual' ).
  15. write( 'and defining a name operator that assigned the appropriate name to the' ).
  16. write( 'number, as in name_of(1,william_the_conqueror)' ).
  17. write( 'This is because many of the names of women were omitted in my source ' ).
  18. write( 'and were entered only as x.  This leads to problems in searching out ' ).
  19. write( 'some of the kin relationships in this data base. ' ).
  20. write( 'p371' ).
  21. parents(james_I,henry_stuart_lord_darnley,mary_queen_of_Scots).
  22. parents(arabella_stuart,charles_stuart_earl_of_Lenox,x).
  23. parents(william_seymour,edward_lord_beauchamp,x).
  24. parents(edward_lord_beauchamp,edward_seymour_earl_of_Hertford,catherine_grey).
  25. parents(mary_queen_of_scots,james_V_of_Scotland,mary_of_Lorraine).
  26. parents(henry_stuart_lord_darnley,matthew_stuart_earl_of_Lenox,margaret_douglas).
  27. parents(charles_stuart_earl_of_Lenox,matthew_stuart_earl_of_Lenox,margaret_douglas).
  28. parents(lady_jane_grey,henry_grey_duke_of_Suffolk,frances_brandon).
  29. parents(catherine_grey,henry_grey_duke_of_Suffolk,frances_brandon).
  30. parents(margaret,earl_of_Cumberland,eleanor_brandon).
  31.  
  32. parents(james_V_of_Scotland,james_IV_of_Scotland,margaret_tudor).
  33. parents(margaret_douglas,archibald_douglas_earl_of_Angus,margaret_tudor).
  34. parents(frances_brandon,charles_brandon_duke_of_Suffolk,mary_tudor).
  35. parents(eleanor_brandon,charles_brandon_duke_of_Suffolk,mary_tudor).
  36.  
  37. parents(mary_tudor_2,henry_VIII,catharine_of_Aragon).
  38. parents(elizabeth_I,henry_VIII,anne_boleyn).
  39. parents(edward_VI,henry_VIII,jane_seymour).
  40.  
  41. parents(arthur_tudor,henry_VII,elizabeth).
  42. parents(henry_VIII,henry_VII,elizabeth).
  43. parents(margaret_tudor,henry_VII,elizabeth).
  44. parents(mary_tudor,henry_VII,elizabeth).
  45.  
  46. write( 'p269' ).
  47. parents(edward,henry_VI,margaret_of_Anjou).
  48. parents(henry_VII,edmund_tudor_earl_of_richmond,margaret).
  49. parents(elizabeth,edward_IV,x).
  50. parents(edward_V,edward_IV,x).
  51. parents(richard_of_York,edward_IV,x).
  52.  
  53. parents(henry_VI,henry_V,catharine_of_France).
  54. parents(edmund_tudor_earl_of_richmond,owen_tudor_earl_of_Richmond,catharine_of_France).
  55. parents(margaret,john_beaufort_duke_of_Somerset,x).
  56. parents(edward_IV,richard_duke_of_York,anne_d_of_roger_mortimer_jr).
  57. parents(richard_III,richard_duke_of_York,anne_d_of_roger_mortimer_jr).
  58. parents(george_duke_of_Clarence,richard_duke_of_York,anne_d_of_roger_mortimer_jr).
  59.  
  60. parents(edmund,roger_mortimer_jr,x).
  61. parents(anne_d_of_roger_mortimer_jr,roger_mortimer_jr,x).
  62. parents(henry_V,henry_IV,x).
  63. parents(thomas_duke_of_Gloucester,henry_IV,x).
  64. parents(john_duke_of_Bedford,henry_IV,x).
  65. parents(humphrey_duke_of_Gloucester,henry_IV,x).
  66. parents(john_beaufort_duke_of_Somerset,john_beaufort,x).
  67. parents(richard_duke_of_York,richard_earl_of_Cambridge,x).
  68.  
  69. parents(roger_mortimer_jr,roger_mortimer_sr,phillippa).
  70.  
  71. parents(richard_II,edward_the_Black_Prince,x).
  72. parents(phillippa,lionel_duke_of_Clarence,x).
  73. parents(henry_IV,john_of_Gaunt_duke_of_Lancaster,blanche).
  74. parents(john_beaufort,john_of_Gaunt_duke_of_Lancaster,catherine_swynford).
  75. parents(edward_duke_of_York,edmund_duke_of_York,x).
  76. parents(richard_earl_of_Cambridge,edmund_duke_of_York,x).
  77.  
  78. parents(edward_the_Black_Prince,edward_III,x).
  79. parents(william,edward_III,x).
  80. parents(lionel_duke_of_Clarence,edward_III,x).
  81. parents(john_of_Gaunt_duke_of_Lancaster,edward_III,x).
  82. parents(edmund_duke_of_York,edward_III,x).
  83. parents(thomas_duke_of_Gloucester,edward_III,x).
  84.  
  85. parents(edward_III,edward_II,isabella_of_France).
  86.  
  87. write( 'p195' ).
  88. parents(joan,edward_I,eleanor_of_Castile).
  89. parents(margaret_m_john_II_of_Brabant,edward_I,eleanor_of_Castile).
  90. parents(elizabeth_m_humphrey_of_Hereford,edward_I,eleanor_of_Castile).
  91. parents(edward_II,edward_I,eleanor_of_Castile).
  92. parents(thomas,edward_I,margaret_of_France).
  93. parents(edmund,edward_I,margaret_of_France).
  94. parents(edward_I,henry_III,eleanor_of_Provence).
  95. parents(margaret_m_alexander_III_of_Scotland,henry_III,eleanor_of_Provence).
  96. parents(edmund,henry_III,eleanor_of_Provence).
  97. parents(henry_III,john_Lackland,isabella_of_Angouleme).
  98. parents(richard_of_Cornwall,john_Lackland,isabella_of_Angouleme).
  99. parents(henry,henry_II,eleanor_of_Aquitaine).
  100. parents(richard_I_Coeur_de_Lion,henry_II,eleanor_of_Aquitaine).
  101. parents(geoffrey,henry_II,eleanor_of_Aquitaine).
  102. parents(john_Lackland,henry_II,eleanor_of_Aquitaine).
  103. parents(arthur,geoffrey,x).
  104. parents(henry_II,geoffrey_of_Anjou_Plantagenet,matilda).
  105. parents(matilda,henry_I,matilda_of_Scotland).
  106. parents(robert,william_I_the_Conqueror,matilda_of_Flanders).
  107. parents(willaim_II_Rufus,william_I_the_Conqueror,matilda_of_Flanders).
  108. parents(henry_I,william_I_the_Conqueror,matilda_of_Flanders).
  109. parents(adele,william_I_the_Conqueror,matilda_of_Flanders).
  110. parents(stephen,stephen_of_Blois,adele).
  111.  
  112. same(X,X) :- atom(X).
  113. diff(X,Y) :- not(same(X,Y)).
  114.  
  115. mother_of(X,Y) :- parents(Y,Z,X).
  116. father_of(X,Y) :- parents(Y,X,Z).
  117.  
  118. married(X,Y) :- parents(Z,X,Y).
  119.  
  120. incest(X,Y) :- married(X,Y), sister_of(Y,X).
  121. incest(X,Y) :- married(X,Y), mother_of(Y,X).
  122. incest(X,Y) :- married(X,Y), father_of(X,Y).
  123. incest(X,Y) :- married(X,Y), brother_of(X,Y).
  124.  
  125. female(X) :- mother_of(X,Y).
  126. male(X) :- father_of(X,Y).
  127. no_sex(X) :- atom(X),
  128.              not(male(X)),
  129.              not(female(X)),
  130.              true.
  131.  
  132. parent_of(X,Y) :- mother_of(X,Y).
  133. parent_of(X,Y) :- father_of(X,Y).
  134.  
  135. child_of(X,Y) :- parent_of(Y,X).
  136.  
  137. ancestor_of(X,Y) :-
  138.      parent_of(X,Y).
  139. ancestor_of(X,Y) :-
  140.      parent_of(W,Y),
  141.      ancestor_of(X,W).
  142. descendent_of(X,Y) :-
  143.      ancestor_of(Y,X).
  144.  
  145.  
  146. sister_of(X,Y) :-
  147.         female(X),
  148.         parents(X,M,F),
  149.         parents(Y,M,F),
  150.         diff(X,Y),
  151.         true.
  152. brother_of(X,Y) :-
  153.         male(X),
  154.         parents(X,M,F),
  155.         parents(Y,M,F),
  156.         diff(X,Y),
  157.         true.
  158. sibling_of(X,Y) :-
  159.         brother_of(X,Y).
  160. sibling_of(X,Y) :-
  161.         sister_of(X,Y).
  162.  
  163. p_half_sister_of(X,Y) :-
  164.         female(X),
  165.         parents(X,M,Z),
  166.         parents(Y,M,W),
  167.         diff(Z,W),
  168.         true.
  169. m_half_sister_of(X,Y) :-
  170.         female(X),
  171.         parents(X,Z,F),
  172.         parents(Y,W,F),
  173.         diff(Z,W),
  174.         true.
  175. half_sister_of(X,Y) :- p_half_sister_of(X,Y).
  176. half_sister_of(X,Y) :- m_half_sister_of(X,Y).
  177.  
  178. p_half_brother_of(X,Y) :-
  179.         male(X), 
  180.         parents(X,M,Z), 
  181.         parents(Y,M,W), 
  182.         diff(Z,W), 
  183.         true.  
  184.  
  185. m_half_brother_of(X,Y) :-
  186.         male(X),
  187.         parents(X,Z,F),
  188.         parents(Y,W,F),
  189.         diff(Z,W),
  190.         true.
  191.  
  192. half_brother_of(X,Y) :- p_half_brother_of(X,Y).
  193. half_brother_of(X,Y) :- m_half_brother_of(X,Y).
  194.  
  195. half_sibling_of(X,Y) :-
  196.         half_sister_of(X,Y).
  197. half_sibling_of(X,Y) :-
  198.         half_brother_of(X,Y).
  199.  
  200. p_aunt_of(X,Y) :-
  201.         parents(Y,M,F),
  202.         sister_of(X,M).
  203. m_aunt_of(X,Y) :-
  204.         parents(Y,M,F),
  205.         sister_of(X,F).
  206. aunt_of(X,Y) :- p_aunt_of(X,Y).
  207. aunt_of(X,Y) :- m_aunt_of(X,Y).  
  208.  
  209. p_uncle_of(X,Y) :-
  210.         parents(Y,M,F),
  211.         brother_of(X,M).
  212. m_uncle_of(X,Y) :-
  213.         parents(Y,M,F),
  214.         brother_of(X,F).
  215. uncle_of(X,Y) :- p_uncle_of(X,Y).
  216. uncle_of(X,Y) :- m_uncle_of(X,Y).  
  217.  
  218. nuncle_of(X,Y) :- aunt_of(X,Y).
  219. nuncle_of(X,Y) :- uncle_of(X,Y).
  220.  
  221.  
  222. half_aunt_of(X,Y) :-
  223.         parents(Y,M,F),
  224.         half_sister_of(X,M).
  225. half_aunt_of(X,Y) :-
  226.         parents(Y,M,F),
  227.         half_sister_of(X,F).
  228. half_uncle_of(X,Y) :-
  229.         parents(Y,M,F),
  230.         half_brother_of(X,M).
  231. half_uncle_of(X,Y) :-
  232.         parents(Y,M,F),
  233.         half_brother_of(X,F).
  234. half_nuncle_of(X,Y) :-
  235.         half_uncle_of(X,Y).
  236. half_nuncle_of(X,Y) :-
  237.         half_aunt_of(X,Y).
  238.  
  239. cousin_of(X,Y) :-
  240.         nuncle_of(Z,X),
  241.         child_of(Y,Z).
  242.  
  243. half_cousin_of(X,Y) :-
  244.         half_nuncle(Z,X),
  245.         child_of(Y,Z).
  246.         
  247. pp_cousin_of(X,Y) :-
  248.         parents(X,A,B),
  249.         parents(Y,C,D),
  250.         sibling_of(A,C).
  251. pc_cousin_of(X,Y) :-
  252.         parents(X,A,B),
  253.         parents(Y,C,D),
  254.         sibling_of(A,D).
  255. mc_cousin_of(X,Y) :-
  256.         parents(X,A,B),
  257.         parents(Y,C,D),
  258.         sibling_of(B,C).
  259. mp_cousin_of(X,Y) :-
  260.         parents(X,A,B),
  261.         parents(Y,C,D),
  262.         sibling_of(B,D).
  263.  
  264. parallel_cousin_of(X,Y) :-
  265.         pp_cousin_of(X,Y).
  266. parallel_cousin_of(X,Y) :-
  267.         mp_cousin_of(X,Y).
  268. cross_cousin_of(X,Y) :-
  269.         pc_cousin_of(X,Y).
  270. cross_cousin_of(X,Y) :-
  271.         mc_cousin_of(X,Y).
  272.  
  273. pp_half_cousin_of(X,Y) :-
  274.         parents(X,A,B),
  275.         parents(Y,C,D),
  276.         half_sibling_of(A,C).
  277. pc_half_cousin_of(X,Y) :-
  278.         parents(X,A,B),
  279.         parents(Y,C,D),
  280.         half_sibling_of(A,D).
  281. mc_half_cousin_of(X,Y) :-
  282.         parents(X,A,B),
  283.         parents(Y,C,D),
  284.         half_sibling_of(B,C).
  285. mp_half_cousin_of(X,Y) :-
  286.         parents(X,A,B),
  287.         parents(Y,C,D),
  288.         half_sibling_of(B,D).
  289. half_cousin_of(X,Y) :-
  290.         pp_half_cousin_of(X,Y),
  291.         pc_half_cousin_of(X,Y),
  292.         mc_half_cousin_of(X,Y),
  293.         mp_half_cousin_of(X,Y).
  294. half_parallel_cousin_of(X,Y) :-
  295.         pp_half_cousin_of(X,Y),
  296.         mp_half_cousin_of(X,Y).
  297. half_cross_cousin_of(X,Y) :-
  298.         pc_half_cousin_of(X,Y),
  299.         mc_half_cousin_of(X,Y).
  300.  
  301. any_cousin_of(X,Y) :-
  302.         ancestor_of(Z,X),
  303.         ancestor_of(W,Y),
  304.         sibling_of(Z,W).
  305.  
  306.  
  307.  
  308.